home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / GW AdaEd 1.4.2 / GWAdaDemos / GWU Demos / random.adb < prev    next >
Text File  |  1993-10-09  |  1KB  |  56 lines
  1. WITH Calendar;
  2. USE  Calendar;
  3.  
  4. PACKAGE BODY Random IS
  5.  
  6. -- Body of random number generator package.
  7. -- Adapted from the Ada literature by
  8. -- Michael B. Feldman, The George Washington University, November 1990.
  9.  
  10.   Modulus      : CONSTANT := 9317;
  11.  
  12.   TYPE Int_16 IS RANGE - 2 ** 15 .. 2 ** 15 - 1;
  13.  
  14.   TYPE Int_32 IS RANGE - 2 ** 31 .. 2 ** 31 - 1;
  15.  
  16.   SUBTYPE Seed_Range IS Int_16 RANGE 0 .. (Modulus - 1);
  17.  
  18.   Seed,
  19.   Default_Seed : Seed_Range;
  20.  
  21.   PROCEDURE Set_Seed (N : Positive) IS
  22.   BEGIN
  23.     Seed := Seed_Range (N);
  24.   END Set_Seed;
  25.  
  26.   FUNCTION  Unit_Random RETURN Float IS
  27.     Multiplier : CONSTANT := 421;
  28.     Increment  : CONSTANT := 2073;
  29.     Result     : Float;
  30.   BEGIN
  31.     Seed := (Multiplier * Seed + Increment) MOD Modulus;
  32.     Result := Float (Seed) / Float (Modulus);
  33.     RETURN Result;
  34.   EXCEPTION
  35.     WHEN Constraint_Error | Numeric_Error =>
  36.       Seed := Int_16 ((Multiplier * Int_32 (Seed) + Increment) MOD Modulus);
  37.       Result := Float (Seed) / Float (Modulus);
  38.       RETURN Result;
  39.  
  40.   END Unit_Random;
  41.  
  42.   FUNCTION  Random_Int (N : Positive) RETURN Positive IS
  43.     Result : Integer RANGE 1 .. N;
  44.   BEGIN
  45.     Result := Integer (Float (N) * Unit_Random + 0.5);
  46.     RETURN Result;
  47.   EXCEPTION
  48.     WHEN Constraint_Error | Numeric_Error =>
  49.       RETURN 1;
  50.  
  51.   END Random_Int;
  52. BEGIN
  53.   Default_Seed := Int_16 (Int_32 (Seconds (Clock)) MOD Modulus);
  54.   Seed := Default_Seed;
  55. END Random;
  56.